unit ufMainForm;
(* Copyright (C) 2008 by Steven R. Kamradt
   History
   =======
   12/07/09 - Initial version published to Google Code Hosting
   12/08/09 - Inadverntatly missed the WMCleanupPages message routine, added and
              updated the repository.
*)


interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uiWizard, StdCtrls, ExtCtrls, Contnrs, ImgList;

const
  wm_CleanupPages = wm_User + 101;

type
  TMainForm = class(TForm,IWizardManager)
    pnlEmbed: TPanel;
    pnlBottomButtons: TPanel;
    BtnNext: TButton;
    BtnPrev: TButton;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnPrevClick(Sender: TObject);
    procedure BtnNextClick(Sender: TObject);
  private
    { Private declarations }
    fCurForm : TForm;
    fPageStack : TStringList;
    fDelPages : tObjectList;
    fAllowDeletion : boolean;
    procedure WMCleanupPages(var Msg:tmessage); message wm_CleanupPages;
  public
    function CurForm: TForm;
    procedure NavigateToPage(ClassName: string; PushToStack: Boolean = True);
    procedure PopStackToPage(ClassName: string);
    procedure SetAllowDeletion(Active: Boolean);
    procedure SetNextEnabled(bEnabled: Boolean);
    procedure SetNextType(iType: Integer; Caption: string = '');
    procedure SetPrevEnabled(bEnabled: Boolean);
    procedure SetPrevType(iType: Integer; Caption: string = '');
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation


{$R *.dfm}

{ TForm1 }

procedure TMainForm.BtnNextClick(Sender: TObject);
var
  NextPage : IWizardNextPage;
  bDoClose : boolean;
begin
  // set a flag here, since the fCurForm may be changed with
  // the next call.
  bDoClose := Supports(fCurForm,IWizardExitPage);

  if Supports(fCurForm,IWizardNextPage,NextPage) then
    NextPage.NextPageEvent;

  if bDoClose then
    Close;
end;

procedure TMainForm.BtnPrevClick(Sender: TObject);
var
  PrevPage : IWizardPrevPage;
  PopStack : boolean;
  sPage : String;
begin
  PopStack := true;
  if Supports(fCurForm,IWizardPrevPage,PrevPage) then
    PrevPage.PrevPageEvent(PopStack);
  if PopStack and (fPageStack.Count > 0) then
    begin
      sPage := fPageStack.Strings[fPageStack.count-1];
      fPageStack.Delete(fPageStack.Count-1);
      NavigateToPage(sPage,False);
    end;
end;

function TMainForm.CurForm: TForm;
begin
  Result := fCurForm;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  fAllowDeletion := true;
  fPageStack := TStringList.create;
  fDelPages := tObjectList.create;
  fDelPages.OwnsObjects := true;
  // Show the initial page in the wizard.  This has to be done here.
  // the pushtostack doesn't matter, since there is no page to push.
  NavigateToPage('TSampleWizardPage');
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  fAllowDeletion := true;
  fPageStack.Free;
  fDelPages.Free;
  if Assigned(fCurForm) then
    fCurForm.Free;
end;

procedure TMainForm.NavigateToPage(ClassName: string; PushToStack: Boolean);
var
  FrmClass : tFormClass;
  WizSaveState : IWizardSaveState;
  WizFocusControl : IWizardFocusControl;
  WizPage : IWizardPage;
  SCursor : tCursor;
  fLastForm : tForm;
begin
  fLastForm := nil;
  SCursor := screen.cursor;
  frmClass := tformClass(FindClass(ClassName));
  if frmClass = nil then
    Raise Exception.Create('Unable to locate the form class '+Name);
  TRY
    // display the wait cursor & lock the screen from updating.
    Screen.Cursor := crHourGlass;
    lockwindowupdate(Handle);
    // if there is a previous form inplace, then handle the removal
    if Assigned(fCurForm) then
      begin
        if PushToStack then
          fPageStack.Add(fCurForm.ClassName);
        if Supports(fCurForm,IWizardSaveState,WizSaveState) then
          WizSaveState.SaveState;
        WizSaveState := nil;
        // add to the delete pages list since removing the object here might
        // cause an access violation since it was most likely the one which
        // invoked this method.
        fDelPages.Add(fCurForm);
      end;
    {create and attach the requested form}
    fCurForm := frmClass.create(nil);
    fCurForm.Parent := pnlEmbed;
    fCurForm.BorderStyle := bsNone;
    fCurForm.Align := alClient;
    fCurForm.Visible := true;
    {set the button defaults}
    btnPrev.Tag := 0;
    SetNextType(wbt_Next);
    SetNextEnabled(false);
    SetPrevType(wbt_Prev);
    SetPrevEnabled(false);
    btnNext.OnClick := btnNextClick;
    btnNext.Cancel := false;
    btnNext.Visible := Supports(fCurForm,IWizardNextPage) or Supports(fCurForm,IWizardExitPage);
    btnPrev.Visible := (fPageStack.Count > 0) or Supports(fcurForm,IWizardPrevPage);
    SetPrevEnabled(fPageStack.Count > 0);

    if (not btnNext.Visible) and (btnPrev.Visible) then
      begin
        btnPrev.Tag := 1;
        btnNext.Visible := btnPrev.Visible;
        btnNext.Caption := btnPrev.Caption;
        btnNext.ImageIndex := btnPrev.ImageIndex;
        btnNext.OnClick := btnPrevClick;
        btnNext.Enabled := btnPrev.Enabled;
        btnPrev.Visible := false;
      end;

    {notify the page of the wizard manager}
    if Supports(fCurForm,IWizardpage,WizPage) then
      WizPage.SetWizardManager(self);
    if Supports(fcurForm,IWizardFocusControl,WizFocusControl) then
      ActiveControl := WizFocusControl.InitialFocusControl;
  FINALLY
    lockwindowupdate(0);
    Screen.Cursor := SCursor;
  END;
  // Tell the system to cleanup any pages which are left in memory.
  // Post rather than send as if this doesn't run, it shouldn't be any
  // big deal other than there would be the memory allocated to the removed
  // forms still in memory.
  PostMessage(handle,wm_CleanupPages,0,0);

end;

procedure TMainForm.PopStackToPage(ClassName: string);
var
  ix : integer;
  scur : string;
begin
  ix := fPageStack.count-1;
  while (ix >= 0) do
    begin
      sCur := fPagestack.Strings[ix];
      fPagestack.Delete(ix);
      if SameText(ClassName,sCur) or SameText('#'+ClassName,sCur) then break;
      ix := fPageStack.count-1;
    end;
  NavigateToPage(Classname,false);
end;

procedure TMainForm.SetAllowDeletion(Active: Boolean);
begin
  fAllowDeletion := Active;
end;

procedure TMainForm.SetNextEnabled(bEnabled: Boolean);
begin
  btnNext.Enabled := bEnabled;
end;

procedure TMainForm.SetNextType(iType: Integer; Caption: string);
begin
  if Caption = '' then
    case iType of
      wbt_Next   : btnNext.Caption := '&Next';
      wbt_Prev   : BtnNext.Caption := '&Back';
      wbt_Ok     : BtnNext.Caption := 'Ok';
      wbt_Cancel : BtnNext.Caption := '&Cancel';
      wbt_First  : BtnNext.Caption := '&First';
      wbt_Finish : BtnNext.Caption := 'Finish';
      wbt_Clear  : BtnNext.Caption := 'Clear';
      wbt_Save   : BtnNext.Caption := 'Save';
    end
  else
    btnNext.Caption := Caption;
  btnNext.ImageIndex := iType;
  btnNext.Default := iType in [wbt_Ok,wbt_Save,wbt_Finish];
  BtnNext.Cancel := iType in [wbt_Cancel,wbt_Clear];
end;

procedure TMainForm.SetPrevEnabled(bEnabled: Boolean);
begin
  BtnPrev.Enabled := bEnabled;
end;

procedure TMainForm.SetPrevType(iType: Integer; Caption: string);
begin
  if Caption = '' then
    case iType of
      wbt_Next   : btnPrev.Caption := '&Next';
      wbt_Prev   : btnPrev.Caption := '&Back';
      wbt_Ok     : btnPrev.Caption := 'Ok';
      wbt_Cancel : btnPrev.Caption := '&Cancel';
      wbt_First  : btnPrev.Caption := '&First';
      wbt_Finish : btnPrev.Caption := 'Finish';
      wbt_Clear  : btnPrev.Caption := 'Clear';
      wbt_Save   : btnPrev.Caption := 'Save';
    end
  else
    btnPrev.Caption := Caption;
  btnPrev.ImageIndex := iType;
  btnPrev.Default := iType in [wbt_Ok,wbt_Save,wbt_Finish];
  btnPrev.Cancel := iType in [wbt_Cancel,wbt_Clear];
end;

procedure TMainForm.WMCleanupPages(var Msg: tmessage);
begin
  if fAllowDeletion then
    fDelPages.Clear;
end;

end.
